Packard Bell - Internet on a CD/internet on a cd.cdr/Internet/sites/Clementine_NASA/image.hqx/Image folder/Macros/More Macros

Text File | 1991-08-05 | 8.0 KB | 387 lines

macro 'Make Mosaic';
var
  n:integer;
begin
  SaveState
  n:=GetNumber('Cell Size(pixels square):',8);
  Duplicate('Mosaic');
  SetScaling('Nearest; Same Window');
  ScaleSelection(1/n,1/n);
  RestoreRoi;
  ScaleSelection(n,n);
  RestoreState;
end;


macro 'Draw Vertical Scale with Labels';
var
  left,top,width,height,i,x,y2,inc:integer;
  y:real;
begin
  GetRoi(left,top,width,height);
  if width=0 then begin
    PutMessage('Make a selection first.');
    exit;
  end;
  SetFont('Helvetica');
  SetFontSize(10);
  SetText('Plain; Left; no background');
  SetLineWidth(1);
  Setforeground(255);
  DrawScale;
  x:=left;
  y:=top;
  inc:=height/10;
  for i:=1 to 11 do begin
    MoveTo(x+width+10,round(y)+2);
    y2:=round(y);
    if i=11 then y2:=y2-1;
    write(cvalue(GetPixel(x,y2)):1:2);
    y:=y+inc;
  end;
end;


macro 'Speckle Paint [S]';
var
  x,y,ranx,rany,MaxSpeckSize,size,Spread:integer;
begin
  {SaveState;}
  Spread:=50;
  MaxSpeckSize:=5;
  KillRoi;
  repeat
    GetMouse(x,y);
    if button then begin
      ranx:=x+Spread*(Random-0.5);
      rany:=y+Spread*(Random-0.5);
      size:=(MaxSpeckSize-2)*random+2;
      MakeOvalRoi(ranx-size,rany-size,size*2,size*2);
      SetForeground(Random*254+1)
      fill;
    end;
  until (x<0) or (y<0);
  KillRoi;
  {RestoreState;}
end;


macro 'Draw Histogram';
var
  max,scale:real;
  i,margin,width,height:integer;
begin
  SaveState;
  Margin:=10;
  width:=256;
  height:=0.6*256;
  Measure;
  SetForegroundColor(255);
  SetBackgroundColor(0);
  SetLineWidth(1);
  SetNewSize(width+2*margin,height+2*margin);
  MakeNewWindow('Histogram');
  MakeRoi(margin,margin-1,width,height+1);
  DrawBoundary;
  max:=0;
  for i:=1 to 254 do
  if histogram[i]> max then max:=histogram[i];
  scale:=height/max;
  for i:=1 to 254 do begin
    MakeRoi(margin+i,margin,1,histogram[i]*scale);
    SetForegroundColor(i);
    fill;
 end;
  SelectAll;
  FlipVertical;
  KillRoi;
  RestoreState;
end;


macro 'Subtract Background';
var
  i,Corrected:integer;
begin
  SelectAll;
  Duplicate('Background Corrected');
  Corrected:=PicNumber;
  Duplicate('Background');
  ScaleSelection(.25,.25);
  RestoreRoi;
  for i:=1 to 10 do begin
    SetOption; Smooth;
  end;
  ScaleSelection(4,4);
  SelectAll;
  Copy;
  SelectPic(Corrected);
  Paste;
  Subtract;
  ResetGrayMap;
end;


macro 'ASCII Dump';
{
Generates an alphanumeric listing of pixels values starting at
the upper left corner of the current selection. 20 rows and 44 columns
can be displayed with the default 552 x 436 window. The size of the window
used to display the pixel values is determined by New Width and
New Height in the Prefernces dialog box.
}
var
  image,dump,roiLeft,roiTop,roiWidth,roiHeight:integer;
  h,v,value,MaxWidth,MaxHeight,width,height:integer;
begin
  image:=PicNumber;
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  if roiWidth=0 then begin
    PutMessage('This macro requires a rectangular selection');
    exit;
  end;
  SetForegroundColor(255);
  SetBackgroundColor(0);
  MakeNewWindow('ASCII Dump');
  dump:=PicNumber;
  GetPicSize(width,height);
  MaxWidth:=width div 24 - 2;
  MaxHeight:=height div 9 - 3;
  if roiWidth>MaxWidth then roiWidth:=MaxWidth;
  if roiHeight>MaxHeight then roiHeight:=MaxHeight;
  SetFont('Monaco');
  SetFontSize(9);
  SetText('No background; Left Justified');
  MoveTo(2,12);
  write('    ');
  for h:=roiLeft to roiLeft+roiWidth-1 do write(h:4);
  writeln;
  writeln;
  for v:=roiTop to roiTop+roiHeight-1 do begin
    write(v:3,' ');
    for h:=roiLeft to roiLeft+roiWidth-1 do begin
      ChoosePic(image);
      value:=GetPixel(h,v);
      ChoosePic(dump);
      write(value:4);
    end;
    writeln;
  end;
  ChoosePic(image);
end;


macro 'Resize All';
{
Resizes and/or rotates all currently open widows. For example,
change the  ScaleAndRotate command below to
ScaleAndRotate(2,2,0)  to change the size of all the images
in a movie loop sequence from 128 x 128 to 256 x 256.
}
var
  i:integer;
begin
  SaveState;
  SetScaling('Bilinear; Create New Window');
  for i:=1 to nPics do begin
    ChoosePic(1);
    ScaleAndRotate(1.9,1.9,0);
    ChoosePic(1);
    Close;
  end;
  for i:=1 to nPics do begin
    ChoosePic(i);
    SetPicName(i);
  end;
  RestoreState;
end;


macro 'Dispose All';
begin
  DisposeAll;
end;

macro 'Average two Images';
  {Generates the arithmetic average of two images.}
begin
  if nPics<>2 then begin
    PutMessage('This macro requires exactly two image windows to be open.');
    Exit;
  End;
  ScaleMath(false);
  MultiplyByConstant(0.5);
  NextWindow;
  MultiplyByConstant(0.5);
  SelectAll;
  Copy;
  NextWindow;
  Paste;
  Add;
end;


macro 'Make Montage [M]';
{Opens a new window and creates in it a composite image made from all}
{currently open images. All the images must be the same size.}
var
  width,height,w,h,mWidth,mHeight,nWindows,left,top:integer;
  RoiWidth,RoiHeight,RoiWidth,RoiHeight,i,hloc,vloc:integer;
  montage,temp:integer;
  scale:real;
  SameSize:boolean;
begin
  nWindows:=nPics;
  SameSize:=true;
  GetPicSize(width,height);
  for i:=1 to nPics do begin
    SelectPic(i);
    GetPicSize(w,h);
    SameSize:=SameSize and (w=width) and (h=height);
  end;
  if (nWindows<2) or not SameSize then begin
    PutMessage('This macro needs two or more images of the same size in order to create a montage.');
    Exit;
  end;
  SetBackground(0);
  MakeNewWindow('Montage');
  montage:=nWindows+1;
  GetPicSize(mWidth,mHeight);
  SelectPic(1);
  Duplicate('Temp');
  temp:=nWindows+2;
  scale:=GetNumber('Scaling Factor:',0.25);
  hloc:=-(RoiWidth);
  vloc:=0;
  for i:=1 to nWindows do begin
    SelectPic(i);
    SelectAll;
    copy;
    SelectPic(temp);
    paste;
    SelectAll;
    ScaleSelection(scale,scale);
    RestoreRoi;
    if i=1 then begin
      GetRoi(left,top,RoiWidth,RoiHeight);
      hloc:=-RoiWidth;
      vloc:=0;
    end;
    Copy;
    SelectPic(montage);
    hloc:=hloc+RoiWidth;
    if (hloc+RoiWidth)>mWidth then begin
      hloc:=0;
      vloc:=vloc+RoiHeight;
    end;
    MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
    Paste;
  end;
  KillRoi;
  SelectPic(temp);
  Dispose;
end;


macro 'Make Sine Wave';
var
  left,top,width,height,i:integer;
  ppp,scale:real;
begin
  SaveState;
  MakeNewWindow('Sine Wave');
  SelectAll;
  GetRoi(left,top,Width,Height);
  if width=0 then begin
    PutMessage('This macro requires a rectangular selection.');
    Exit;
  end;
  ppp:=GetNumber('Pixels per period',100);
  Scale:=ppp/6.28;
  MakeRoi(left,top,1,height);
  for i:=1 to width do begin
    SetForeground(sin(i/scale)*127 +128);
    {SetForeground((sin(i/scale)*127 +128)*(i+30)/(width));}
    fill;
    MoveRoi(1,0);
  end;
  KillRoi;
  RestoreState;
end;`


macro 'Grid';
var
  n,PicWidth,PicHeight,hloc,vloc,size:integer;
begin
  SaveState;
  n:=24;
  GetPicSize(PicWidth,PicHeight);
  if PicWidth=0 then begin
    PutMessage
    ('This macro needs an opened image, preferably in color, to operate on.');
    Exit;
  end;
  size:=round(PicWidth/n);
  repeat
    hloc:=((PicWidth*random) div size)*size;
    vloc:=((PicHeight*random) div size)*size;
    MakeRoi(hloc,vloc,size,size);
    SetForeground(255*random);
    fill;
    {Invert;}
  until Button;
  KillRoi;
  RestoreState;
end;


macro 'Plot XYZ';
{
Plots X-Y coordinate points with an optional intensity(Z). Values are read from
a 2 or 3 column tab-delimited text file. Data must be scaled as follows:
0<=X<width; 0<=Y<height; 0<=Z<=255.
}
var
  width,height:integer;
begin
  width:=450;
  height:=500;
  SetNewSize(width,height);
  MakeNewWindow('Plot');
  PlotXYZ;
end;


macro '(---'; begin end;

macro '5x5 [5]';
{
Note: you only see the open file dialog box the first time one of
these macros is called, since Image keeps track of the folder
containing the convolution kernels.
}
begin
  convolve('Hat(5x5)');
end;

macro '7x7  [7]'
begin
  convolve('Hat(7x7)');
end;

macro '9x9  [9]'
begin
  convolve('Hat(9x9)');
end;


macro '(---'; begin end;

{These macros allow you to easily switch}
{transfer modes while pasting by tapping keys.}
macro 'Copy Mode[F1]'; begin SetOption; DoCopy; end;
macro 'AND Mode[F2]';  begin SetOption; DoAnd; end;
macro 'OR Mode [F3]';  begin SetOption; DoOr; end;